home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD010b.dsk / HIDDEN.LINE.3D.bas < prev    next >
BASIC Source File  |  2003-06-12  |  6KB  |  198 lines
  1. 5  REM     <CTRL-M><CTRL-M><CTRL-M>FROM A PROGRAM BY MARK GOTTLIEB, PRINTED IN THE MAY '78 'BYTE', P 49.  MODIFIED FOR APPLE II BY ALAN LACY<CTRL-J><CTRL-J>
  2. 10  TEXT : CALL  -936: VTAB 4: PRINT "THIS IS A PROGRAM WHICH PLOTS 3-D FUNC- TIONS AND USES A HIDDEN LINE SUBROUTINE"
  3. 15  PRINT "A DETAILED EXPLANATION OF THIS PROGRAM  IS IN THE MAY '78 'BYTE', P 49."
  4. 20  PRINT : PRINT "THE FUNCTION PLOTTED (LINE 410) CAN BE  CHANGED, AS WELL AS OTHER PARAMETERS."
  5. 25  PRINT "DEPENDING ON RESOLUTION, A PLOT AVER-   AGES FIFTEEN MINUTES"
  6. 30  PRINT : PRINT "HIT ANY KEY TO BEGIN THE PLOT"
  7. 40  GET D$: PRINT : PRINT : PRINT 
  8. 90  LOMEM: 16384
  9. 100  HGR 
  10. 110 U4 = 0:F = 1:U5 = F
  11. 120 L9 = 10
  12. 150  DIM A(1,3): DIM C(1,3)
  13. 160  DIM Q(3,3): DIM B(279,1)
  14. 165  REM  PERSPECTIVE FUNCTION
  15. 170  DEF  FN P(F) = D7 *F/(D7 -C(1,3))
  16. 180  REM  E=STEP VALUE AND K=#STEPS
  17. 190 E = 10:K = 15
  18. 200 I =  -E:I2 = E
  19. 210  REM  D7=DISTANCE FROM (0,0,0) FOR PERSPECTIVE
  20. 220 D7 = 30
  21. 230  REM  X2,Y2,Z2 ARE DEG. TURN AROUND X,Y&Z AXIS
  22. 240 X2 =  -75:Y2 = 0:Z2 = 30
  23. 250 W = 3.1416/180: REM  CONVERSION FACTOR DEGREES TO RADIANS
  24. 260 X2 = W *X2:Y2 = W *Y2:Z2 = W *Z2
  25. 290  GOSUB 6000
  26. 300 X3 =  -1:Y3 = X3:X4 = X3:Y4 = X3
  27. 310  FOR H = 0 TO 279
  28. 320 B(H,1) = 159: NEXT 
  29. 325  REM  Y AXIS LOOP
  30. 330  FOR T =  -E TO E  STEP E/K
  31. 340  IF T > -.05  AND T <.05  THEN T = 0
  32. 345  REM  X AXIS LOOP
  33. 350  FOR G =  -E TO E  STEP E/K
  34. 360  IF G > -.05  AND G <.05  THEN G = O
  35. 370 U9 = G
  36. 380 R =  SQR(G *G +T *T)
  37. 390 A(1,1) = G
  38. 400 A(1,2) = T
  39. 405  REM  ACTUAL FUNCTION
  40. 410 A(1,3) = 8/(R +1) * COS(R *1.2)
  41. 415  REM  MATRIX MULTIPLICATION SUBROUTINE
  42. 420  FOR L = 1 TO 3
  43. 421  FOR J = 1 TO 1
  44. 422 C(J,L) = 0
  45. 423  FOR M = 1 TO 3
  46. 424 C(J,L) = C(J,L) +A(J,M) *Q(M,L)
  47. 425  NEXT : NEXT : NEXT 
  48. 429  REM  SCALING, PERSPECTIVE, & OFFSET
  49. 430 X =  FN P(C(1,1) *100/E) +140
  50. 440 Y =  -1 *( FN P(C(1,2) *100/E) -80)
  51. 445  REM  GOSUB HIDDEN LINE SUBROUTINE
  52. 450  GOSUB 5000
  53. 460  NEXT : NEXT 
  54. 470  PRINT "END OF PLOT": PRINT "<CTRL-G><CTRL-G><CTRL-G>"
  55. 480  END 
  56. 4085  REM    <CTRL-M><CTRL-M><CTRL-M>VARIABLES USED IN HIDDEN LINE SUBROUTINE:<CTRL-M>U1-U9,S7-S9,X1,Y1-X9,Y9. U8=0    (LAST IN),U8=1 (LAST OUT)<CTRL-J>
  57. 4090  REM <CTRL-M><CTRL-M>VARIABLES SET AT BEGINNING OF PROGRAM:<CTRL-M>SET I=1ST X & I2=LAST X<CTRL-M>U4=0,F=U5=1,X4=Y4=X3=Y3=-1<CTRL-J>
  58. 4095  REM <CTRL-M><CTRL-M>U9=VALUE OF X STEP<CTRL-J>
  59. 4097  REM <CTRL-M><CTRL-M>L9=MAX LENGTH OF LINE<CTRL-J>
  60. 4099  REM <CTRL-M><CTRL-M><CTRL-M>*** HIDDEN LINE SUBROUTINE ***<CTRL-J>
  61. 5000  IF X >279  OR X <0  THEN U4 = 1
  62. 5005  IF X >279  OR X <0  THEN  RETURN 
  63. 5010  IF U9 = I  AND Y >B(X,1)  AND Y <B(X,0)  THEN 5140
  64. 5015  IF U9 = I  OR U4  THEN  GOSUB 5600
  65. 5020  IF U9 = I2  THEN  GOSUB 5700
  66. 5025 U3 = 0
  67. 5030  IF U9 = I  OR U4  THEN 5155
  68. 5033  IF X -X9 = 0  THEN 5125
  69. 5034  REM  STEPS 5035-5085 DIVIDE LINES INTO LINES OF LENGTH L9
  70. 5035 L8 =  SQR((X -X9) ^2 +(Y9 -Y) ^2)
  71. 5040  IF L8 < = L9  THEN 5090
  72. 5045 L2 = X9:L5 = X:L6 = Y:S6 = (Y9 -Y)/(X -X9)
  73. 5050 L7 = (X -X9)/(L9/L8):L4 = Y9 -S6 *X9
  74. 5060  FOR X = L2 TO L5 -L7  STEP L7
  75. 5065 Y = S6 *X +L4
  76. 5070  GOSUB 5090
  77. 5075  NEXT 
  78. 5080 X = L5:Y = L6
  79. 5090  IF X -X9 = 0  THEN 5145
  80. 5099 U3 = 0
  81. 5100 S9 = (Y9 -Y)/(X -X9)
  82. 5105  IF U8 = 0  THEN 5400
  83. 5110  IF Y >B(X,1)  AND Y <B(X,0)  THEN 5205
  84. 5115 U8 = 1
  85. 5120  IF U9 = 1  THEN 5155
  86. 5125  GOSUB 8200
  87. 5130  GOSUB 5500
  88. 5135  GOTO 5145
  89. 5140 U8 = 0
  90. 5145 X9 = X:Y9 = Y
  91. 5150  RETURN 
  92. 5151  REM  RETURN TO MAIN PROGRAM
  93. 5155 X9 = X:Y9 = Y
  94. 5160  GOSUB 8100
  95. 5165  GOSUB 8200
  96. 5170 U4 = 0
  97. 5175 U8 = 1
  98. 5180  RETURN 
  99. 5181  REM  RETURN TO MAIN PROGRAM
  100. 5200  REM  *** FIND INTERSECT ***
  101. 5205 S7 = X -X9:U2 = 0:X1 = X9:U1 = 1
  102. 5210  IF U1 >32  THEN 5285
  103. 5215 U1 = U1 *2
  104. 5220  IF U2 = 1  THEN 5235
  105. 5225 X1 = X1 +S7/U1
  106. 5230  GOTO 5240
  107. 5235 X1 = X1 -S7/U1
  108. 5240 Y7 =  ABS(S9 *(X1 -X9) -Y9)
  109. 5245  IF U3 = 1  THEN 5456
  110. 5250  IF Y9 <B(X9,0)  THEN 5270
  111. 5255  IF Y7 <B(X1,0)  THEN U2 = 1
  112. 5260  IF Y7 >B(X1,0)  THEN U2 = 0
  113. 5265  GOTO 5280
  114. 5270  IF Y7 >B(X1,1)  THEN U2 = 1
  115. 5275  IF Y7 <B(X1,1)  THEN U2 = 0
  116. 5280  GOTO 5210
  117. 5285 X5 = X:Y5 = Y
  118. 5290 X = X1:Y = Y7
  119. 5295  IF U3 = 1  THEN 5425
  120. 5300 U8 = 0
  121. 5305  GOSUB 8200
  122. 5310  GOSUB 5500
  123. 5315 X9 = X5:Y9 = Y5
  124. 5320  RETURN 
  125. 5321  REM  RETURN TO MAIN PROGRAM
  126. 5400  REM  ** TEST U8=0 **
  127. 5405  IF Y <B(X,0)  AND Y >B(X,1)  THEN 5145
  128. 5410 U8 = 1:U3 = 1
  129. 5415 X8 = X:Y8 = Y
  130. 5420  GOTO 5205
  131. 5425  GOSUB 8100
  132. 5430  GOSUB 8200
  133. 5435 X = X8:Y = Y8:U8 = 1
  134. 5440  GOTO 5145
  135. 5450  GOTO 5145
  136. 5454  REM  PART OF THE INTERSECTION ROUTINE
  137. 5455  REM  ** FOR U3=1:COMING OUT **
  138. 5456  IF Y <B(X,1)  THEN 5460
  139. 5457  IF Y7 >B(X1,0)  THEN U2 = 1
  140. 5458  IF Y7 <B(X1,0)  THEN U2 = 0
  141. 5459  GOTO 5280
  142. 5460  IF Y7 <B(X1,1)  THEN U2 = 1
  143. 5465  IF Y7 >B(X1,1)  THEN U2 = 0
  144. 5470  GOTO 5280
  145. 5500  REM ** FILL IN POINTS **
  146. 5505 U6 =  SGN(X -X9)
  147. 5510  IF U6 = 0  THEN  RETURN 
  148. 5515  FOR U7 = X9 TO X  STEP U6
  149. 5520 S8 = Y9 +S9 *(U7 -X9)
  150. 5522  IF S8 >B(U7,0)  THEN B(U7,0) = S8
  151. 5524  IF S8 <B(U7,1)  THEN B(U7,1) = S8
  152. 5530  NEXT 
  153. 5535  RETURN 
  154. 5600  REM  ** FILL IN LEFT SIDE **
  155. 5610  IF X4 < > -1  THEN 5640
  156. 5620 X4 = X:Y4 = Y
  157. 5630  RETURN 
  158. 5640 X8 = X9:Y8 = Y9
  159. 5650 X9 = X4:Y9 = Y4
  160. 5660 S9 = (Y9 -Y)/(X -X9)
  161. 5670  GOSUB 5500
  162. 5680 X9 = X8:Y9 = Y8
  163. 5690  GOTO 5620
  164. 5700  REM  ** FILL IN RIGHT SIDE **
  165. 5710  IF X3 < > -1  THEN 5740
  166. 5720 X3 = X:Y3 = Y
  167. 5730  RETURN 
  168. 5740 X8 = X9:Y8 = Y9
  169. 5750 X9 = X3:Y9 = Y3
  170. 5760 S9 = (Y9 -Y)/(X -X9)
  171. 5770  GOSUB 5500
  172. 5780 X9 = X8:Y9 = Y8
  173. 5790  GOTO 5720
  174. 6000  REM  MAT ROTATE
  175. 6001  REM  6020-6110 MAKES MATRIX
  176. 6002  REM  Q THE FINAL ROTATIONAL
  177. 6003  REM  MATRIX
  178. 6020 Q(1,1) =  COS(Z2) * COS(Y2)
  179. 6030 Q(2,1) =  -1 * SIN(Z2) * COS(Y2)
  180. 6040 Q(3,1) =  -1 * SIN(Y2)
  181. 6050 Q(1,2) =  COS(Z2) *( -1) * SIN(X2) * SIN(Y2) + SIN(Z2) * COS(X2)
  182. 6060 Q(2,2) =  SIN(Z2) * SIN(X2) * SIN(Y2) + COS(Z2) * COS(X2)
  183. 6070 Q(3,2) =  -1 * SIN(X2) * COS(Y2)
  184. 6080 Q(1,3) =  COS(Z2) * COS(X2) * SIN(Y2) + SIN(Z2) * SIN(X2)
  185. 6090 Q(2,3) =  -1 * SIN(Z2) * COS(X2) * SIN(Y2) + COS(Z2) * SIN(X2)
  186. 6100 Q(3,3) =  COS(X2) * COS(Y2)
  187. 6110  RETURN 
  188. 8099  REM  'INVISIBLE VECTOR' SUBROUTINE
  189. 8100 A = 1: RETURN 
  190. 8199  REM  VISIBLE VECTOR SUBROUTINE
  191. 8200  HCOLOR= 7
  192. 8205  IF X >279  THEN X = 279
  193. 8206  IF X <0  THEN X = 0
  194. 8207  IF Y >159  THEN Y = 159
  195. 8208  IF Y <0  THEN Y = 0
  196. 8217  IF A = 1 GOTO 8230
  197. 8220  HPLOT  TO X,Y: RETURN 
  198. 8230  HPLOT X,Y:A = 0: RETURN